home *** CD-ROM | disk | FTP | other *** search
/ SGI Freeware 2002 November / SGI Freeware 2002 November - Disc 1.iso / dist / fw_exmh.idb / usr / freeware / lib / exmh-2.5 / pgpMain.tcl.z / pgpMain.tcl
Text File  |  2002-07-08  |  51KB  |  1,586 lines
  1. #
  2. # pgp.tcl
  3. #    PGP 2.6 support for exmh.
  4. #    Orginally contributed by Allan Downey
  5. #    Updated by Stefan Monnier, Anders Klemets, William Sproule,
  6. #    Chris Garrigues and Ben Escoto
  7. #
  8.  
  9. # future:
  10. # - rewrite PGP decrypt, to deal with keys, mime stuff, etc...
  11. # - encrypt pgp parts, similar to the automatic quote-printable
  12. # - split big functions
  13. # - drop misc_displaytext
  14. # - add a "init PGP" command
  15. # - add some key handling commands
  16. # - keep track of who has your private key (for revocation purposes)
  17.  
  18. # Pgp_Init is in extrasInit.tcl
  19. # to avoid auto-loading this whole file.
  20.  
  21. # $Log: pgpMain.tcl,v $
  22. # Revision 1.23  2001/07/11 18:13:59  welch
  23. # ftp.expect.MASTER:
  24. # inc.expect.MASTER: Changed to a #!/bin/sh header with exec hack
  25. # to be able to insert the -- flag to expect
  26. # install.tcl: Changed the expect patching to match the above change
  27. # lib/pgpMain.tcl:
  28. # lib/mime.tcl: Changed MsgTextHighlight to Msg_TextHighlight
  29. # lib/msgShow.tcl: Added Msg_HighlightInit
  30. # lib/sedit.tcl: Added SeditBeautify from John Beck
  31. # lib/seditBind.tcl: Added "highlight" virtual function to sedit bindings
  32. # lib/app-defaults: Added <Control-l> binding to sedit to beautify it.
  33. #
  34. # Revision 1.22  2001/07/09 16:45:33  welch
  35. # Jumbo commit - I think I forgot to commit a few things from the
  36. # aborted 2.4 release as well.  The main thing is the addition of
  37. # message highlighting.
  38. #
  39. # Makefile:
  40. # exmh.README:
  41. # exmh.CHANGES:
  42. # lib/html/exmh.README.html:
  43. # lib/html/index.html:
  44. # lib/html/software.html:
  45. # version.sed:
  46. # exmh.install: Changing version number to 2.5
  47. # exmh-bg.MASTER:
  48. # exmh.MASTER: Fixed initialization of exmh(userLibrary)
  49. # inc.expect.MASTER:  Fixed !# line so it gets installed right
  50. # lib/app-defaults-color: Added resources for message highlighting
  51. # based on the jcl-beautify code.
  52. # lib/autorefile.tcl: Contributed code by John Carroll
  53. # lib/fdispColor.tcl:
  54. # lib/fdisp.tcl: Added use of c_unseenBg and c_movedFg color resources
  55. # for further refinement of unseen and moved messages.
  56. # lib/inc.tcl: Cleanup of Inc_Expect
  57. # lib/mailcap.tcl: Fixed bug in mailcap parsing code that didn't quote
  58. # & in rules, leading to message corruption in SaveAttachments code.
  59. # lib/mh.tcl: minor tweak to variable unset
  60. # lib/mime.tcl: Added highlightText option and calls to Msg_TextHighlight.
  61. # *  lib/msgShow.tcl: Added Msg_TextHighlight and the jcl-beautify code,
  62. # with minor changes to separate the bug reporting header highlighting
  63. # into a different hook.  There is now a "message show" hook that
  64. # operates on the whole message, a "message highlight" hook that
  65. # only operates on the text regions of a message.
  66. # lib/pgpMain.tcl: Added call to Msg_TextHighlight.
  67. # lib/pop.tcl: Fixed Pop_Dialog so it works right with multiple hosts.
  68. #
  69. # Revision 1.21  2000/06/16 18:16:26  valdis
  70. # Various PGP fixes...
  71. #
  72. # Revision 1.20  2000/04/22 10:34:49  gruber
  73. # Handle PGP messages without Version: xxx
  74. #
  75. # Revision 1.19  1999/10/27 14:59:27  kchrist
  76. # Quick application/pgp bug fix.
  77. #
  78. # Revision 1.18  1999/10/25 15:38:39  kchrist
  79. # Added a dropKeys pattern to pgpGPG.tcl.
  80. #
  81. # Simplified PGP GUI by removing "detached" signature option. Problem
  82. # was that MIME+standard includes a copy of the message being signed
  83. # in the signature attachement. What really should be used is
  84. # MIME+detached. Decided to overload the meaning of "standard". If
  85. # the format is plain, standard means "binary". If the format is
  86. # anything else, standard means "detached". Less flexibility but
  87. # better chances of "doing the right thing".
  88. #
  89. # Revision 1.17  1999/10/07 14:29:28  kchrist
  90. # Changed quote file name documentation string to remove ambiguity regarding
  91. # the location of this file.
  92. #
  93. # Fixed a PGP bug when sign-encrypting a MIME message.
  94. #
  95. # Revision 1.16  1999/09/30 14:55:20  kchrist
  96. # One more fix to the cmd_User issue.
  97. #
  98. # Revision 1.15  1999/09/30 03:51:07  kchrist
  99. # pgp($v,cmd_Beauty) was getting in the way of pgp($v,cmd_User) for
  100. # v=gpg so I had to rearrange things a bit.
  101. #
  102. # Revision 1.14  1999/09/27 23:18:45  kchrist
  103. # More PGP changes. Consolidated passphrase entry to sedit field or
  104. # pgpExec routine. Made the pgp-sedit field aware of pgp(keeppass)
  105. # and pgp(echopass). Moved pgp(keeppass), pgp(echopass) and
  106. # pgp(grabfocus) to PGP General Interface. Fixed a minor bug left
  107. # over from my previous GUI changes. Made pgp-sedit field appear and
  108. # disappear based on its enable preference setting.
  109. #
  110. # Revision 1.13  1999/09/22 16:36:44  kchrist
  111. # Changes made to support a different structure under the PGP Crypt... button.
  112. # Instead of an ON/OFF pgp($v,sign) variable now we use it to specify
  113. # the form of the signature (none, standard, detached, clear, or w/encrypt).
  114. # Code changed in several places to support this new variable definition.
  115. #
  116. # Updated Sedit.html to include a description of the new interface.
  117. #
  118. # Revision 1.12  1999/08/24 15:51:07  bmah
  119. # Patch from Kevin Christian to make email PGP key queries work, and
  120. # to make key attachment RFC 2015 compliant.
  121. #
  122. # Revision 1.11  1999/08/22 19:21:33  bmah
  123. # Remove More...->old PGP->Encrypt menu.  Getting this to work will be
  124. # really hard and there doesn't seem to be a lot of demand for it, given
  125. # the other PGP functionality.
  126. #
  127. # Revision 1.10  1999/08/18 15:52:37  bmah
  128. # Commit modification to seditpgp user interface, and fix a couple of
  129. # bugs.
  130. #
  131. # Revision 1.9  1999/08/13 00:39:05  bmah
  132. # Fix a number of key/passphrase management problems:  pgpsedit now
  133. # manages PGP versions, keys, and passphrases on a per-window
  134. # basis.  Decryption now works when no passphrases are cached.
  135. # One timeout parameter controls passphrases for all PGP
  136. # versions.  seditpgp UI slightly modified.
  137. #
  138. # Revision 1.8  1999/08/11 06:16:39  bmah
  139. # Properly decode multipart/signed PGP messages whose boundary strings
  140. # contain characters that are interpreted as special regexp characters.
  141. #
  142. # Revision 1.7  1999/08/05 15:46:29  bmah
  143. # Fix seditpgp key-changing button label code (update properly when
  144. # user changes her key or changes the PGP version).
  145. #
  146. # Revision 1.6  1999/08/04 22:43:39  cwg
  147. # Got passphrase timeout to work yet again
  148. #
  149. # Revision 1.5  1999/08/04 00:21:57  iko
  150. # Fix multiple Mime-Version: with pgp signed messages
  151. #
  152. # Revision 1.4  1999/08/03 18:06:43  bmah
  153. # Permit user to cancel selection of a private key for signing (affects
  154. # the "Choose Key..." dialog in sedit and the button at the bottom of the
  155. # pgpsedit window).
  156. #
  157. # Revision 1.3  1999/08/03 16:31:43  cwg
  158. # Display the body of a message which fails to be decoded by PGP.
  159. #
  160. # Revision 1.2  1999/08/03 04:05:55  bmah
  161. # Merge support for PGP2/PGP5/GPG from multipgp branch.
  162. #
  163. # Revision 1.8  1999/05/06 15:36:41  cwg
  164. # If there's a PGP error while processing the message, show the message raw.
  165. #
  166. # Revision 1.7  1999/05/05 14:58:10  cwg
  167. # Modifed Jan Peterson's code to make better use of screen real estate.
  168. #
  169. # Revision 1.6  1999/04/30 19:09:00  cwg
  170. # Jan Peterson's multiple PGP key patch
  171. #
  172. # Revision 1.5  1999/04/20 21:46:17  cwg
  173. # Is CVS working now?
  174. #
  175. # Revision 1.4  1999/04/15 23:41:59  cwg
  176. # Make the crypt menu values be per-window instead of global.
  177. #
  178. # Revision 1.3  1999/03/29 20:49:20  cwg
  179. # If doing a plain signature, disable usage of the pgp(mime) flag.
  180. #
  181. # Revision 1.2  1999/03/26 08:41:55  cwg
  182. # Changes to PGP interface to use preferences variables instead of
  183. # message headers.  Also, reorganize the "PGP..." menu and rename it
  184. # "Crypt..."
  185. #
  186. # See the "PGP interface" preferences page for more info.
  187. #
  188. # Revision 1.1  1998/05/05 17:55:37  welch
  189. # Initial revision
  190. #
  191. # Revision 1.1  1998/05/05 17:42:59  welch
  192. # Initial revision
  193. #
  194. # Revision 1.16  1998/01/22  00:47:01  bwelch
  195. #     Fixed Pgp_Setup to use /dev/tty instead of /dev/console
  196. #
  197. # Revision 1.15  1997/12/22  20:53:46  bwelch
  198. # File_Delete
  199. #
  200. # Revision 1.14  1997/07/25  17:14:09  bwelch
  201. # Trapped error messages from PGP xterms.
  202. #
  203. # Revision 1.13  1997/07/12  23:06:28  bwelch
  204. #     Added expecttk support for PGP handling.
  205. #     Fixed recursive failures with some PGP messages.
  206. #
  207. # Revision 1.12  1997/06/03  18:37:00  bwelch
  208. # Added doinc flag to Inc_Presort
  209. # Major cleanup
  210. #
  211. # Revision 1.11  1997/01/25  06:21:16  bwelch
  212. # Added Quote module support
  213. #
  214. # Revision 1.10  1997/01/25  05:34:08  bwelch
  215. #     Added Pgp_GetTextAttributes
  216. # Changed display of PGP messages
  217. #
  218. # Revision 1.9  1996/12/21  00:58:08  bwelch
  219. # Fixed PGP menu to support both email and www key fetching.
  220. # Guard against missing signature parts in multipart/signed
  221. #
  222. # Revision 1.8  1996/12/02  21:11:11  bwelch
  223. # Moved New Key button to be inside the help documents.
  224. #
  225. # Revision 1.7  1996/12/01  20:16:47  bwelch
  226. # Added mutipart/security support.
  227. # (Ben Escoto and Chris Garrigues)
  228. #
  229. # Revision 1.6  1996/03/22  18:44:34  bwelch
  230. # Changed graphic part separator size in PGP from 5 to 6 to avoid
  231. #     downloading a new font for this case.
  232. #
  233. # Revision 1.5  1995/09/28  04:11:10  bwelch
  234. # Fixed "hasfcc" check in PGP.
  235. #
  236. # Revision 1.4  1995/06/30  18:32:40  bwelch
  237. # Upcase PGP mail headers
  238. #
  239. # Revision 1.3  1995/06/09  20:57:06  bwelch
  240. # Added ChoosePrivateKey
  241. #
  242. # Revision 1.2  1995/05/24  06:01:38  bwelch
  243. # Added Pgp_SetMyName to choose private key name
  244. #
  245. # Revision 1.1  1995/05/24  01:48:03  bwelch
  246. # Initial revision
  247. #
  248. # Revision 1.21  1995/04/15  18:17:01  welch
  249. # Introduced msg(path)
  250. #
  251. # Revision 1.20  1995/03/22  22:17:30  welch
  252. # Changed exmh.PGP.help to help.PGP
  253. #
  254. # Revision 1.19  1995/03/22  18:53:52  welch
  255. # More new code from Stefan
  256. #
  257. # Revision 1.1  1994/12/17  20:18:49  monnier
  258. # Initial revision
  259. #
  260.  
  261. # Setup is invoked by the "Make Key" button on the PGP Setup Help page
  262. # It searches for versions on the system, which are supported by exmh.
  263. # Setup then configures the version found on your system.
  264. #
  265. # If there are more than one version found on the system,
  266. # then a dialog box pops up and asks the user for the version, he/she wants
  267. # to configure.
  268. # She/He can choose her/his preferred version(s).
  269. #
  270. proc Pgp_Setup {} {
  271.     global env pgp
  272.  
  273.     Pgp_SetPath
  274.  
  275.     foreach v $pgp(supportedversions) {
  276.         foreach path [split $env(PATH) ":"] {
  277.         if [file executable "$path/[set pgp($v,executable,key)]"] {
  278.         lappend installed $v
  279.         break
  280.         }
  281.     }
  282.     }
  283.  
  284.     # Nothing installed
  285.     if {![info exists installed]} {
  286.     tk_messageBox -type ok -title "PGP Setup" -icon error \
  287.                       -message "A PGP executable is not in your PATH. You'll have to find it (or install it) before I can do anything for you."
  288.         return
  289.     }
  290.  
  291.     # dialog box, if more than one version found
  292.     if { [llength $installed] >= 2 } {
  293.         if [winfo exists .hugo] {
  294.             return
  295.         }
  296.     set t [toplevel .hugo]
  297.     wm title $t "Which version?"
  298.     wm resizable $t 0 0
  299.     set f [frame $t.frame1]
  300.     pack $f -side top
  301.     set l [label $f.pic -bitmap questhead]
  302.     pack $l -side left -padx 5
  303.     set m [message $f.msg -justify left -text \
  304. "There are more than one versions installed on your system. Which version(s) do
  305. you want to use to generate your key?"]
  306.     pack $m -side left
  307.     set f [frame $t.frame2]
  308.     pack $f -side top
  309.     global value
  310.     foreach v $installed {
  311.         set value($v) 0
  312.         set c [checkbutton $f.$v -variable value($v) -text [set pgp($v,fullName)] ]
  313.         pack $c -side left
  314.     }
  315.     set b [button $f.ok -text OK -command [list destroy $t] ]
  316.     pack $b -side left
  317.     
  318.     tkwait window $t
  319.     
  320.     foreach v $installed {
  321.         if {[set value($v)]} {
  322.         lappend wantToInstall $v
  323.         }
  324.     }
  325.     if {![info exists wantToInstall]} {
  326.         return
  327.     }
  328.     } else {
  329.     set wantToInstall $installed
  330.     }
  331.  
  332.     foreach v $wantToInstall {
  333.     # setup directory
  334.     catch { exec mkdir [set pgp($v,defaultPath)] }
  335.     # setup config file
  336.     catch { exec touch [set pgp($v,configFile)] }
  337.     # make the key pair(s) and self sign it/them
  338.     if [catch {
  339.         exec xterm -title "[set pgp($v,fullName)] Setup" -e sh \
  340.                            -c [set pgp($v,keyGenCmd)] >& /dev/tty } error] {
  341.         tk_messageBox -title "[set pgp($v,fullName)] Setup Error" -type ok \
  342.                           -icon error -message "An error occurred while trying to generate your key: \n$error\n please try these commands at your unix shell to generate your key and self sign it: \n[set pgp($v,keyGenCmd)]\n Then restart exmh to enable its [set pgp($v,fullName)] support."
  343.             return
  344.         }
  345.  
  346.     # init the support if necessary
  347.         if {![set pgp($v,enabled)]} {
  348.         Pgp_Init
  349.         } else {
  350.         set pgp($v,privatekeys) [Pgp_Exec_KeyList $v $pgp($v,ownPattern) Sec]
  351.         }
  352.  
  353.     # something todo after keygeneration, send to keyserver ?
  354.     if {[info exists pgp($v,afterKeyGen)]} {
  355.         eval [set pgp($v,afterKeyGen)]
  356.     }
  357.     }
  358. }
  359.  
  360. proc Pgp_Help {} {
  361.     Help PGP    ;# Make Key button is embedded in the HTML
  362. }
  363.  
  364. proc Pgp_HelpOld {} {
  365.     global exmh
  366.     set label "Help about setting up PGP"
  367.     if [Exwin_Toplevel .pgphelp "PGP Help" PgpHelp] {
  368.     Widget_Label .pgphelp.but label {left fill} -text $label
  369.     Widget_AddBut .pgphelp.but setup "Make Key" [list Pgp_Setup]
  370.     
  371.     set t [Widget_Text .pgphelp 30 -setgrid true]
  372.     Ftoc_ColorConfigure $t
  373.     $t insert insert "EXMH Version: $exmh(version)\n\n"
  374.     if [catch {open "$exmh(library)/help.PGP" r} in] {
  375.         $t insert insert "Cannot find file exmh.PGP.help to display"
  376.         $t configure -state disabled
  377.     } else {
  378.         $t insert insert [read $in]
  379.     }
  380.     }
  381. }
  382.  
  383.  
  384. proc Pgp_SetPath {} {
  385.     global env pgp
  386.  
  387.     foreach v $pgp(supportedversions) {
  388.         if {[info exists pgp($v,path)] && \
  389.         ([string length [string trim [set pgp($v,path)]]] > 0) && \
  390.         ([lsearch -exact [split $env(PATH) :] [set pgp($v,path)]] < 0)} {
  391.         set env(PATH) [set pgp($v,path)]:$env(PATH)
  392.     }
  393.     }
  394. }
  395.  
  396. # XXX Orphaned code, from exmh More->old PGP->encrypt menu
  397. # encrypts the current message with the user's key
  398. proc Pgp_ExmhEncrypt { v } {
  399.     global exmh msg mhProfile pgp
  400.  
  401.     set file $msg(path)
  402.     set tmpfile [Mime_TempFile "encrypt"]
  403.  
  404.     Exmh_Status "pgp -e $exmh(folder)/$msg(id)"
  405.  
  406. #    set pgp(param,recipients) [lindex $pgp($v,myname) 0]
  407.     set id [SeditId $file]
  408.     set pgp(encrypt,$id) 1;
  409.     set pgp(sign,$id) "none";
  410.     set pgp(format,$id) "pm";
  411.  
  412.     Pgp_Process $v $file $tmpfile
  413.  
  414.     Mh_Rename $tmpfile $file
  415.  
  416.     set msg(dpy) {}
  417.     MsgChange $msg(id)
  418.  
  419.     return 1
  420. }
  421.  
  422. # XXX Orphaned code (pgp-action headers no longer used)
  423. # Removes any pgp-action header and inserts a brand new one
  424. proc Pgp_SeditEncrypt { action v draft t } {
  425.     global pgp
  426.  
  427.     SeditSave $draft $t
  428.  
  429.     # remove pgp-action header
  430.     Pgp_Misc_RemovePgpActionHeader $t hasfcc
  431.  
  432.     # check, if pgp enabled
  433.     if { ![set pgp($v,enabled)] } {
  434.     SeditMsg $t "[set pgp($v,fullName)] not enabled"
  435.     return
  436.     }
  437.  
  438.     if {"$action" == "none"} {
  439.         return
  440.     }
  441.  
  442.     # Build header
  443.     set pgpaction "Pgp-Action: $action"
  444.     if [set pgp($v,rfc822)] {
  445.     append pgpaction "; rfc822=on"
  446.     } else {
  447.     append pgpaction "; rfc822=off"
  448.     }
  449.     # # # # # #
  450.     # S I G N
  451.     if [regexp {sign} $action] {
  452.        if { [set pgp($v,choosekey)] && [llength [set pgp($v,privatekeys)]] > 1} {
  453.       set signkey [Pgp_ChoosePrivateKey $v "Please select the key to use for signing"]
  454.        } else {
  455. # XXX fix this
  456.       set signkey [set pgp($v,myname)]
  457.        }
  458.        append pgpaction ";\n\toriginator=\"[lindex $signkey 0]\""
  459.     }
  460.     # # # # # # # # #
  461.     # E N C R Y P T
  462.     if [regexp {encrypt} $action] {
  463.     if [catch { append pgpaction ";\n\trecipients=\"[join [Pgp_Misc_Map key {lindex $key 4} \
  464.           [Pgp_Match_Whom $v $draft $hasfcc]] ",\n\t\t    "]\"" } err] {
  465.             Exmh_Debug "<PGP SeditEncrypt>: $err"
  466.         }
  467.     }
  468.     append pgpaction ";\n\tpgp-version=$v"
  469.  
  470.     # insert it
  471.     $t insert 1.0 "$pgpaction\n"
  472. }
  473.  
  474. # XXX Orphaned code (from now-dead sedit Crypt...->PGP Preview menu item)
  475. proc Pgp_EncryptDebug { srcfile } {
  476.     global pgp env miscRE
  477.  
  478.     set orig [open $srcfile r]
  479.  
  480.     Exmh_Debug Pgp_EncryptDebug
  481.  
  482.     set id [SeditId $srcfile]
  483.     set v $pgp(version,$id)
  484.  
  485.     # get the header of the draft and split it into mime and non-mime headers
  486.     set allheaders [Pgp_Misc_Segregate line \
  487.         {[regexp $miscRE(mimeheaders) $line]} [Pgp_Misc_GetHeader $orig]]
  488.     
  489.     close $orig
  490.  
  491.     set mimeheaders [lindex $allheaders 0]
  492.     set mailheaders [lindex $allheaders 1]
  493.     
  494.     if {[lsearch -glob $mimeheaders "content-type:*"] < 0} {
  495.     lappend mimeheaders "content-type: text/plain; charset=us-ascii"
  496.     }
  497.     
  498.     # if there is nothing to do, stop here
  499.     if {!$pgp(encrypt,$id) && $pgp(sign,$id)=="none"} {
  500.     Exmh_Debug "Pgp_EncryptDebug: No action"
  501.     }
  502.  
  503.     # check originator (if necessary)
  504.     if {$pgp(sign,$id) != "none"} {
  505.     if [info exists pgp(param,originator)] {
  506.         set originator [PgpMatch_Simple $pgp(param,originator) $pgp(secring)]
  507.     } else {
  508.         set originator $pgp($v,myname,$id)
  509.     }
  510.     Exmh_Debug "Pgp_EncryptDebug: Signed by: $originator"
  511.     }
  512.  
  513.     # get the ids of the recipients (if necessary)
  514.     if $pgp(encrypt,$id) {
  515.     if [info exists pgp(param,recipients)] {
  516.         Exmh_Debug "Recipients from pgp(param,recipients): $pgp(param,recipients)"
  517.         set ids [Pgp_Misc_Map id {PgpMatch_Simple $id $pgp($v,pubring)} \
  518.             [split $pgp(param,recipients) ","]]
  519.  
  520.     } else {
  521.         set hasfcc [expr {[lsearch -glob $mailheaders "fcc:*"] >= 0}]
  522.  
  523. #        catch {exec whom -nocheck $srcfile} recipients
  524.         catch {exec whom $srcfile} recipients
  525.         Exmh_Debug "Recipients from draft: $recipients"
  526.  
  527.         set ids [Pgp_Match_Whom $v $srcfile $hasfcc]
  528.     }
  529.     Exmh_Debug "Pgp_EncryptDebug: Encrypt to: [join $ids ", "]"
  530.     }
  531.  
  532. }
  533.  
  534. # Choose the private key to use. Default is 1st element of pgp($v,myname) 
  535. # which is set by Pgp_Exec_Init.
  536. proc Pgp_ChoosePrivateKey { v text } {
  537.     global pgp
  538.  
  539.     set signkeys {}
  540.  
  541.     if [catch {Pgp_KeyBox $v $text Sec [set pgp($v,privatekeys)]} signkeys] {
  542.     set signkeys [list [set pgp($v,myname)]]
  543.     return [lindex $signkeys 0]
  544.     } else {
  545.     return $signkeys
  546.     }
  547. }
  548.  
  549. # Change pgp($v,myname,$id) variable and update pgp(cur,pass,$id) along 
  550. # the way. Function is called from the Crypt... menu in Sedit and WhatNow.
  551. proc Pgp_SetMyName { v id } {
  552.    global pgp
  553.  
  554. Exmh_Debug In PGP_SetMyName $v $id
  555.     # first, save old pgp passphrase if set
  556.    if {[info exists pgp(cur,pass,$id)] && \
  557.        ([string length $pgp(cur,pass,$id)] > 0) && \
  558.        [info exists pgp($v,myname,$id)]} {
  559.       set keyid [lindex $pgp($v,myname,$id) 0]
  560.       set pgp($v,pass,$keyid) $pgp(cur,pass,$id)
  561.       if {![info exists pgp(timeout,$keyid)]} {
  562.      Pgp_SetPassTimeout $v $keyid
  563.       }
  564.    }
  565.  
  566.    set newname [Pgp_ChoosePrivateKey $v \
  567.      "Please select a $pgp($v,fullName) key to use for signing"]
  568.    if {[string length $newname]} {
  569.        set pgp($v,myname,$id) [lindex $newname 0]
  570.  
  571.        Exmh_Debug "Pgp_SetMyName: myname now $pgp($v,myname,$id)"
  572.  
  573.        set keyid [lindex $pgp($v,myname,$id) 0]
  574.        if [info exists pgp($v,pass,$keyid)] {
  575.        set pgp(cur,pass,$id) $pgp($v,pass,$keyid)
  576.        } else {
  577.        set pgp(cur,pass,$id) {}
  578.        }
  579.        Pgp_SetSeditPgpName $pgp($v,myname,$id) $id
  580.    }
  581. }
  582.  
  583. # Set seditpgp labels (PGP key name gets set in multiple places
  584. # so we should collapse them all here)
  585. proc Pgp_SetSeditPgpName { myname id } {
  586.     global pgp
  587.  
  588.     set keyid [lindex $myname 0]
  589.     set keyalg [lindex $myname 1]
  590.     set keyname [lindex $myname 4]
  591.     set fullname $pgp($pgp(version,$id),fullName)
  592.     
  593.     set pgp(sedit_label,$id) "$keyname"
  594.     set pgp(sedit_label2,$id) "$fullname KeyID: $keyid ($keyalg)"
  595. }
  596.  
  597. # Update seditpgp PGP version
  598. proc Pgp_SetSeditPgpVersion { v id } {
  599.     global pgp
  600.  
  601.     # Get old PGP passphrase and save it away if it has content.
  602.     set oldv $pgp(version,$id)
  603.     if {[info exists pgp(cur,pass,$id)] && \
  604.         ([string length $pgp(cur,pass,$id)] > 0) && \
  605.         [info exists pgp($oldv,myname,$id)]} {
  606.     set keyid [lindex $pgp($oldv,myname,$id) 0]
  607.     set pgp($oldv,pass,$keyid) $pgp(cur,pass,$id)
  608.     if {![info exists pgp(timeout,$keyid)]} {
  609.         Pgp_SetPassTimeout $oldv $keyid
  610.     }
  611.     }
  612.  
  613.     # If we didn't pick a key for this PGP version yet in this
  614.     # window, then set one from the default.
  615.     if {![info exists pgp($v,myname,$id)]} {
  616.     set pgp($v,myname,$id) $pgp($v,myname)
  617.     }
  618.  
  619.     Exmh_Debug "Pgp_SetSeditPgpVersion: myname now $pgp($v,myname,$id)"
  620.  
  621.     # Now behave as if we'd just chosen a new key (with new version $v)
  622.     set keyid [lindex $pgp($v,myname,$id) 0]
  623.     if [info exists pgp($v,pass,$keyid)] {
  624.     set pgp(cur,pass,$id) $pgp($v,pass,$keyid)
  625.     } else {
  626.     set pgp(cur,pass,$id) {}
  627.     }
  628.     set pgp(version,$id) $v
  629.     Pgp_SetSeditPgpName $pgp($v,myname,$id) $id
  630.  
  631. }
  632.  
  633. proc Pgp_Process { v srcfile dstfile } {
  634.     global pgp env miscRE
  635.  
  636.     set orig [open $srcfile r]
  637.  
  638.     Exmh_Debug Pgp_Process
  639.  
  640.     set id [SeditId $srcfile]
  641.     # get the header of the draft and split it into mime and non-mime headers
  642.     set allheaders [Pgp_Misc_Segregate line \
  643.         {[regexp $miscRE(mimeheaders) $line]} [Pgp_Misc_GetHeader $orig]]
  644.     
  645.     set mimeheaders [lindex $allheaders 0]
  646.     set mailheaders [lindex $allheaders 1]
  647.     
  648.     if {[lsearch -glob $mimeheaders "content-type:*"] < 0} {
  649.     lappend mimeheaders "content-type: text/plain; charset=us-ascii"
  650.     }
  651.     
  652.     # if there is nothing to do, stop here
  653.     if {!$pgp(encrypt,$id) && $pgp(sign,$id)=="none"} {
  654.     close $orig
  655.     error "no action"
  656.     }
  657.  
  658.     if {$pgp(format,$id) == "app"} {
  659.     Exmh_Debug app format
  660.     if {$pgp(encrypt,$id)} {
  661.         set typeparams "; x-action=encrypt;"
  662.     } else {
  663.         switch $pgp(sign,$id) {
  664.         standard {set typeparams "; x-action=signbinary;"}
  665.         clearsign {set typeparams "; x-action=signclear;"}
  666.         encryptsign {set typeparams "; x-action=encryptsign;"}
  667.         }
  668.     }
  669.     }
  670.  
  671.     # setup rfc822
  672.     if [info exists pgp(param,rfc822)] {
  673.     set rfc822 [regexp -nocase $miscRE(true) $pgp(param,rfc822)]
  674.     } else {
  675.     set rfc822 $pgp($v,rfc822)
  676.     }
  677.  
  678.     # setup the originator (if necessary)
  679.     if {$pgp(sign,$id) != "none"} {
  680.     Exmh_Debug PGP signing
  681.     if [info exists pgp(param,originator)] {
  682.         set originator [PgpMatch_Simple $pgp(param,originator) $pgp(secring)]
  683.     } else {
  684.         set originator $pgp($v,myname,$id)
  685.     }
  686.     if {$pgp(format,$id) == "app"} {
  687.         append typeparams "; x-originator=[string range [lindex $originator 0] 2 end]"
  688.     }
  689.     }
  690.  
  691.     # get the ids of the recipients (if necessary)
  692.     if {$pgp(encrypt,$id) || $pgp(sign,$id) == "encryptsign"} {
  693.     Exmh_Debug PGP encrypting
  694.     if [info exists pgp(param,recipients)] {
  695.         set ids [Pgp_Misc_Map id {PgpMatch_Simple $id $pgp($v,pubring)} \
  696.             [split $pgp(param,recipients) ","]]
  697.     } else {
  698.         set hasfcc [expr {[lsearch -glob $mailheaders "fcc:*"] >= 0}]
  699.         set ids [Pgp_Match_Whom $v $srcfile $hasfcc]
  700.     }
  701.     ExmhLog "<Pgp_Process> Encrypting with public key(s): [join $ids ", "]"
  702.  
  703.     if {$pgp(format,$id) == "app"} {
  704.         append typeparams ";\n\tx-recipients=\"[join [Pgp_Misc_Map key {string range [lindex $key 0] 2 end} $ids] ", "]\""
  705.     }
  706.     }
  707.       
  708.     # remove pgp-action and mime-version headers
  709.     set mailheaders [Pgp_Misc_Filter line \
  710.     {![regexp "^(mime-version|pgp-action):" $line]} $mailheaders]
  711.  
  712.     # setup the header of the application/pgp subpart
  713.     if $rfc822 {
  714.     set pgpheaders [concat \
  715.         [list "content-type: message/rfc822" ""] \
  716.         [Pgp_Misc_Filter line {![string match {[bf]cc:*} $line]} $mailheaders] \
  717.         [list "mime-version: 1.0"] \
  718.         $mimeheaders]
  719.     } else {
  720.     set pgpheaders $mimeheaders
  721.     }
  722.  
  723.     # write the message to be encrypted
  724.     set msgfile [Mime_TempFile "msg"]
  725.     set msg [open $msgfile w 0600]
  726.     foreach line $pgpheaders { puts $msg [Pgp_Misc_FixHeader $line] }
  727.     puts $msg ""
  728.     puts -nonewline $msg [read $orig]
  729.     close $orig
  730.     close $msg
  731.  
  732.     set pgpfile [Mime_TempFile "pgp"]
  733.     if [catch {
  734.     Exmh_Debug "encrypt=$pgp(encrypt,$id); sign=$pgp(sign,$id)"
  735.     if {$pgp(encrypt,$id)} {
  736.         Pgp_Exec_Encrypt $pgp(version,$id) $msgfile $pgpfile $ids 
  737.     } else {
  738.         switch $pgp(sign,$id) {
  739.         standard {
  740.             # Depending on format standard may mean different
  741.             # things. It was decided to keep this ambiguity
  742.             # internal instead of exporting it via the GUI.
  743.             if {$pgp(format,$id) == "plain"} {
  744.             Pgp_Exec_Sign $pgp(version,$id) $msgfile $pgpfile \
  745.                 $originator standard
  746.             } else {
  747.             Pgp_Exec_Sign $pgp(version,$id) $msgfile $pgpfile \
  748.                 $originator detached
  749.             }
  750.         }
  751.         clearsign {
  752.             Pgp_Exec_Sign $pgp(version,$id) $msgfile $pgpfile \
  753.                 $originator clearsign
  754.         }
  755.         encryptsign {
  756.             Pgp_Exec_EncryptSign $pgp(version,$id) $msgfile $pgpfile \
  757.                 $originator $ids
  758.         }
  759.         none -
  760.         default {error "<PGP> Message is neither signed, nor encrypted"}
  761.         }
  762.     }
  763.     } err] {
  764.     File_Delete $msgfile
  765.     error $err
  766.     }
  767.  
  768.     # complete mailheaders with the applcation/pgp content-type
  769.     if {[info exists pgp(param,localaction)] && \
  770.         [regexp -nocase $miscRE(true) $pgp(param,localaction)]} { 
  771.     set mailheaders {}
  772.     }
  773.     
  774.     switch $pgp(format,$id) {
  775.         app { 
  776.         Pgp_ProcessAP $v $dstfile $pgpfile $mailheaders $typeparams
  777.         }
  778.         pm { 
  779.             Pgp_ProcessPM $v $dstfile $pgpfile $mailheaders $msgfile $id
  780.         }
  781.         plain { 
  782.             Pgp_ProcessPlain $v $dstfile $pgpfile $mailheaders $msgfile
  783.         }
  784.     }
  785.     
  786.     File_Delete $msgfile $pgpfile
  787. }
  788.  
  789. proc Pgp_ProcessAP {v dstfile pgpfile mailheaders typeparams} {
  790.     global pgp
  791.  
  792.     lappend mailheaders \
  793.                 "mime-version: 1.0" \
  794.                 "content-type: application/pgp; format=mime$typeparams" \
  795.                 "content-transfer-encoding: 7bit"
  796.  
  797.     # write out the new mail file
  798.     set dst [open $dstfile w 0600]
  799.     foreach line $mailheaders { puts $dst [Pgp_Misc_FixHeader $line] }
  800.     puts $dst ""
  801.     set msg [open $pgpfile r]
  802.     puts -nonewline $dst [read $msg]
  803.     close $msg
  804.     close $dst
  805. }
  806.  
  807. proc Pgp_ProcessPM {v dstfile pgpfile mailheaders plainfile id} {
  808.  
  809.     global pgp
  810.  
  811.     set boundary [Mime_MakeBoundary P]
  812.     set micalg [set pgp($v,digestalgo)]
  813.  
  814.     # Put in specified headers.  
  815.     lappend mailheaders "mime-version: 1.0"
  816.     if {$pgp(encrypt,$id)  || $pgp(sign,$id) == "encryptsign"} {
  817.     lappend mailheaders "content-type: multipart/encrypted; boundary=\"$boundary\";\n\t protocol=\"application/pgp-encrypted\""
  818.     } else {
  819.     lappend mailheaders "content-type: multipart/signed; boundary=\"$boundary\";\n\t micalg=pgp-${micalg}; protocol=\"application/pgp-signature\""
  820.     }
  821.     lappend mailheaders "content-transfer-encoding: 7bit"
  822.  
  823.     # Write file
  824.     set dst [open $dstfile w 0600]
  825.     set pgpIO [open $pgpfile r]
  826.  
  827.     foreach line $mailheaders { puts $dst [Pgp_Misc_FixHeader $line] }
  828.     puts $dst ""
  829.     puts $dst "--$boundary"
  830.     if {$pgp(encrypt,$id) || $pgp(sign,$id) == "encryptsign"} {
  831.     puts $dst "Content-Type: application/pgp-encrypted"
  832.     puts $dst ""
  833.     puts $dst "Version: 1"
  834.     puts $dst ""
  835.     puts $dst "--$boundary"
  836.     puts $dst "Content-Type: application/octet-stream"
  837.     puts $dst ""
  838.     puts $dst [read $pgpIO]
  839.     puts $dst "--$boundary--"
  840.     } else {
  841.     set plain [open $plainfile r]
  842.     puts $dst [read $plain]
  843.     close $plain
  844.     puts $dst "--$boundary"
  845.     puts $dst "Content-Type: application/pgp-signature"
  846.     puts $dst ""
  847.     puts $dst [read $pgpIO]
  848.     puts $dst "--$boundary--"
  849.     }
  850.  
  851.     close $dst
  852.     close $pgpIO
  853.  
  854. }
  855.  
  856. proc Pgp_ProcessPlain {v dstfile pgpfile mailheaders plainfile} {
  857.  
  858.     set dst [open $dstfile w 0600]
  859.     set pgpIO [open $pgpfile r]
  860.  
  861.     foreach line $mailheaders { puts $dst [Pgp_Misc_FixHeader $line] }
  862.     puts $dst ""
  863.  
  864.     puts $dst [read $pgpIO]
  865.  
  866.     close $dst
  867.     close $pgpIO
  868. }
  869.  
  870. # Simple version + blank line adding
  871. proc Pgp_CheckVersion { pgpfile varReal varV } {
  872.     upvar $varReal bestversion
  873.     upvar $varV version
  874.     global pgp
  875.  
  876.     Exmh_Debug "Pgp_CheckVersion $pgpfile $varReal $varV"
  877.  
  878.     set in [open $pgpfile r]
  879.     set pgptext [read $in]
  880.     close $in
  881.  
  882.     # Adding necessary blank lines;
  883.     set pgptext [Pgp_CheckBlankLines $pgptext]
  884.     set out [open $pgpfile w]
  885.     puts $out $pgptext
  886.     close $out
  887.  
  888.     # look, which supported versions pattern matches
  889.     foreach v $pgp(supportedversions) {
  890.         if {[regexp [set pgp($v,pat_Version)] $pgptext]} {
  891.             set bestversion $v
  892.             break
  893.         }
  894.     }
  895.     if {![info exists bestversion]} {
  896.         #error "No pattern matches version info in pgp text!"
  897.     Exmh_Debug "No pattern matches version info in pgp text!"
  898.     Exmh_Debug "Falling back to $pgp(noversion)"
  899.     set bestversion $pgp(noversion)
  900.     }
  901.  
  902.     # look, if the version is setup
  903.     # else take the next enabled in the Alien list
  904.     if {![set pgp($bestversion,enabled)]} {
  905.         foreach v [set pgp($bestversion,list_Alien)] {
  906.             if {[set pgp($v,enabled)]} {
  907.                 set version $v
  908.                 break
  909.             }
  910.         }
  911.     } else { set version $bestversion }
  912.     if {![info exists version]} {
  913.         error "No pgp enabled"
  914.     }
  915. }          
  916.  
  917. # Blank line checking and adding, if needed (e.g for some bad OLE messages)
  918. proc Pgp_CheckBlankLines { pgptext } {
  919.     switch -regexp -- $pgptext {
  920.     {BEGIN PGP SIGNED MESSAGE} {
  921.         #####
  922.         # Blank line after
  923.         # -----BEGIN PGP SIGNED MESSAGE-----
  924.         # Hash: SHA1
  925.         #####
  926.         set a [regsub "^(-----BEGIN.+MESSAGE-----\n)(\[^ \n\t:\]+: \[^\n\]+\n)?((\[^ :\t\n]+\[ \t]*)+\n)" $pgptext "\\1\\2\n\\3" pgptext]
  927.         #####
  928.         # Blank line after
  929.         # -----BEGIN PGP SIGNATURE-----
  930.         # Version: PGP
  931.         # Charset: noconv
  932.         # ...    : ...
  933.         #####
  934.         set b [regsub "(-----BEGIN.+SIGNATURE-----\n)((\[^ \n\t:\]+: \[^\n\]+\n)+)((\[^ :\t\n]+\[ \t]*)+\n)" $pgptext "\\1\\2\n\\4" pgptext]
  935.         Exmh_Debug "<Pgp_CheckBlankLines> Number of blank lines added: $a-$b"
  936.         }
  937.     {BEGIN PGP MESSAGE} {
  938.         #####
  939.         # Blank line after
  940.         # -----BEGIN PGP MESSAGE-----
  941.             # Version: PGP
  942.             # Charset: noconv
  943.             # ...    : ...
  944.         #####
  945.         set a [regsub "^(-----BEGIN.+MESSAGE-----\n)((\[^ \n\t:\]+: \[^\n\]+\n)+)((\[^ :\t\n]+\[ \t]*)+\n)" $pgptext "\\1\\2\n\\4" pgptext]
  946.         Exmh_Debug "<Pgp_CheckBlankLines> Number of blank lines added: $a"
  947.         }
  948.     }
  949.     return $pgptext
  950. }
  951.  
  952. # Show multipart/signed
  953. proc Pgp_MimeShowMultipartSignedPgp {tkw part} {
  954.     global mimeHdr mime pgp
  955.  
  956.     # do we have a signature part ?
  957.     if {![info exists mimeHdr($part=2,file)]} {
  958.     error "Missing signature"
  959.     }
  960.  
  961.     # decide which version to use / implicitely checks for pgp enabled
  962.     if { [catch {Pgp_CheckVersion $mimeHdr($part=2,file) real v} err] } {
  963.         Exmh_Debug "<PGP MimeSigned> $err"
  964.         Exmh_Status "Unknown PGP message version"
  965.         set mimeHdr($part=1,color) $mimeHdr($part,color)
  966.     } else {
  967.  
  968.         # Labels to display: "real" is the Version of the program 
  969.         # which prepared the pgp text, "local" the version, which
  970.         # will be used to decode the thing
  971.     set real [set pgp($real,fullName)]
  972.         set local [set pgp($v,fullName)]
  973.  
  974.     if {![info exists mimeHdr($part,pgpdecode)]} {
  975.         if {([set pgp($v,showinline)] == "all") ||
  976.         ([set pgp($v,showinline)] == "signed")} {
  977.         set mimeHdr($part,pgpdecode) 1
  978.         } else { set mimeHdr($part,pgpdecode) 0 }
  979.     }
  980.  
  981.     MimeMenuAdd $part checkbutton \
  982.         -label "$pgp(menutext,signclear) with $local" \
  983.         -command [list busy MimeRedisplayPart $tkw $part] \
  984.         -variable mimeHdr($part,pgpdecode)
  985.  
  986.     if $mimeHdr($part,pgpdecode) {
  987.             if {[catch {Pgp_GetSignedText $tkw $part} res]} {
  988.                 Exmh_Debug "<PGP MimeSigned> $res"
  989.                 Exmh_Status "<PGP> Failed to parse out signed text."
  990.                 set mimeHdr($part=1,color) $mimeHdr($part,color)
  991.                 MimeShowPart $tkw $part=1 [MimeLabel $part part] 1
  992.                 return
  993.             } else { set signedText $res }
  994.  
  995.             # prepare nice sigfile for royal pgp5
  996.             file copy -force $mimeHdr($part=2,file) [set sigfile ${signedText}.asc]
  997.  
  998.         # verify the thing
  999.             Pgp_Exec_VerifyDetached $v $sigfile $signedText msg
  1000.  
  1001.             # clean up behind us
  1002.             File_Delete $sigfile
  1003.  
  1004.             # tune output
  1005.         Pgp_InterpretOutput $v $msg pgpresult
  1006.         if [info exists pgpresult(keyid)] {
  1007.         Exmh_Debug "<PGP MimeSigned> ID: $pgpresult(keyid)"
  1008.         }
  1009.             # display it
  1010.         Pgp_DisplayMsg $v $tkw $part pgpresult
  1011.  
  1012.             # set colors
  1013.         set mimeHdr($part=1,color) [MimeDarkerColor $tkw $mimeHdr($part,color)]
  1014.  
  1015.     } else {
  1016.         $tkw insert insert \
  1017.         "$real signed message - the signature hasn't been checked\n"
  1018.         TextButton $tkw "$pgp(menutext,signclear) with $local" \
  1019.         "$mimeHdr($part,menu) invoke [join $pgp(menutext,signclear) {\ }]\\ with\\ [join $local {\ }]
  1020.                  \n$tkw config -cursor xterm"
  1021.         $tkw insert insert "\n"
  1022.         MimeInsertSeparator $tkw $part 6
  1023.         set mimeHdr($part=1,color) $mimeHdr($part,color)
  1024.     }
  1025.     }
  1026.     MimeShowPart $tkw $part=1 [MimeLabel $part part] 1
  1027. }
  1028.  
  1029. # Show multipart/encrypted
  1030. proc Pgp_MimeShowMultipartEncryptedPgp {tkw part} {
  1031.     global mimeHdr exmh pgp
  1032.  
  1033.     # decide which version to use / implicitely checks for pgp enabled
  1034.     if { [catch {Pgp_CheckVersion $mimeHdr($part=2,file) real v} err] } {
  1035.         Exmh_Debug "<PGP MimeEncrypted> $err"
  1036.         Exmh_Status "Unknown PGP message version"
  1037.         Mime_ShowDefault $tkw $part
  1038.     return
  1039.     }
  1040.  
  1041.     # Labels to display: "real" is the Version of the program 
  1042.     # which prepared the pgp text, "local" the version, which
  1043.     # will be used to decode the thing
  1044.     set real [set pgp($real,fullName)]
  1045.     set local [set pgp($v,fullName)]
  1046.  
  1047.     if {![info exists mimeHdr($part,pgpdecode)]} {
  1048.     if {[set pgp($v,showinline)] == "all"} {
  1049.         set mimeHdr($part,pgpdecode) 1
  1050.     } else { set mimeHdr($part,pgpdecode) 0 }
  1051.     
  1052.         MimeMenuAdd $part checkbutton \
  1053.         -label "$pgp(menutext,encryptsign) with $local" \
  1054.         -command [list busy MimeRedisplayPart $tkw $part] \
  1055.         -variable mimeHdr($part,pgpdecode)
  1056.     }
  1057.  
  1058.     if {!$mimeHdr($part,pgpdecode)} {
  1059.         $tkw insert insert "This is a $real multipart/encrypted message\n"
  1060.     TextButton $tkw "$pgp(menutext,encryptsign) with $local" \
  1061.         "$mimeHdr($part,menu) invoke [join $pgp(menutext,encryptsign) {\ }]\\ with\\ [join $local {\ }]
  1062.          \n$tkw config -cursor xterm"
  1063.     $tkw insert insert "\n"
  1064.     Mime_ShowDefault $tkw $part
  1065.     return
  1066.     }
  1067.     
  1068.     set tmpfile [Mime_TempFile "decrypt"]
  1069.  
  1070.     # Decide whether or not to use expect
  1071.     set decrypt 1
  1072.     if {[info exists pgp($v,useexpectk)]} {
  1073.         if {[set pgp(keeppass)] && \
  1074.                     [info exists exmh(expectk)] && [set pgp($v,useexpectk)]} {
  1075.         # Decrypt with expect
  1076.         Pgp_Exec_DecryptExpect $v $mimeHdr($part=2,file) $tmpfile msg
  1077.             set decrypt 0
  1078.         }
  1079.     }
  1080.     if $decrypt {
  1081.     # Assume only recipient is primary secret key
  1082.     # Use expect to avoid this behavior
  1083.     set recipients [Pgp_Misc_Map elem {string trim $elem} \
  1084.              [split [string range [lindex [set pgp($v,myname)] 0] 2 end] ","]]
  1085.         # Decrypt
  1086.     Pgp_Exec_Decrypt $v $mimeHdr($part=2,file) $tmpfile msg $recipients
  1087.     }
  1088.  
  1089.     # tune output
  1090.     Pgp_InterpretOutput $v $msg pgpresult
  1091.     # display it
  1092.     Pgp_DisplayMsg $v $tkw $part pgpresult
  1093.  
  1094.     # set color
  1095.     set DarkerColor [MimeDarkerColor $tkw $mimeHdr($part,color)]
  1096.     
  1097.     # The following three lines would show the 
  1098.     # application/pgp-encrypted mime section.
  1099.  
  1100.     # set mimeHdr($part=1,color) $DarkerColor
  1101.     # MimeShowPart $tkw $part=1 [MimeLabel $part part] 1
  1102.     # MimeInsertSeparator $tkw $part 5
  1103.     
  1104.     set fileIO [open $tmpfile r]
  1105.     set mimeHdr($part=2,color) $DarkerColor
  1106.     set mimeHdr($part=2,numParts) [MimeParseSingle $tkw $part=2 $fileIO]
  1107.     close $fileIO
  1108.     
  1109.     MimeShowPart $tkw $part=2=1 [MimeLabel $part part] 1
  1110. }
  1111.  
  1112. # Show application/pgp-keys
  1113. proc Pgp_MimeShowPgpKeys {tkw part} {
  1114.     global mimeHdr pgp
  1115.  
  1116.     Exmh_Debug "<Pgp_MimeShowPgpKeys> part: $part"
  1117.  
  1118.     # decide which version to use / implicitely checks for pgp enabled
  1119.     if { [catch {Pgp_CheckVersion $mimeHdr($part,file) real v} err] } {
  1120.         Exmh_Debug "<PGP MimeShowPgpKeys> $err"
  1121.         Exmh_Status "Unknown PGP message version"
  1122.         Mime_ShowDefault $tkw $part
  1123.     return    
  1124.     }
  1125.  
  1126.     # Labels to display: "real" is the Version of the program 
  1127.     # which prepared the pgp text, "local" the version, which
  1128.     # will be used to decode the thing
  1129.     set real [set pgp($real,fullName)]
  1130.     set local [set pgp($v,fullName)]
  1131.  
  1132.     if {![info exists mimeHdr($part,pgpdecode)]} {
  1133.     if {([set pgp($v,showinline)] == "all") ||
  1134.         ([set pgp($v,showinline)] == "keys")} {
  1135.         set mimeHdr($part,pgpdecode) 1
  1136.     } else { set mimeHdr($part,pgpdecode) 0 }
  1137.     }
  1138.  
  1139.     set msg ""
  1140.     if [set pgp($v,autoextract)] {
  1141.     append msg "Automatic extraction of application/pgp-keys\n"
  1142.     Pgp_Exec_ExtractKeys $v $mimeHdr($part,file) out 0
  1143.     append msg $out "\n"
  1144.     } else {
  1145.     TextButton $tkw "Extract $real keys into $local keyring" \
  1146.         "Pgp_Exec_ExtractKeys $v $mimeHdr($part,file) out"
  1147.     $tkw insert insert "\n"
  1148.     }
  1149.  
  1150.     # Add a menu anyway to allow re-extracting
  1151.     MimeMenuAdd $part command \
  1152.         -label "Extract $real keys into $local keyring..." \
  1153.         -command "Pgp_Exec_ExtractKeys $v $mimeHdr($part,file) out"
  1154.  
  1155.     if $mimeHdr($part,pgpdecode) {
  1156.     Pgp_Exec $v key $mimeHdr($part,file) out
  1157.     # NEW
  1158.     regexp [set pgp($v,pat_validKeys)] $out out
  1159.     append msg $out "\n"
  1160.     } 
  1161.  
  1162.     Pgp_InterpretOutput $v $msg pgpresult
  1163.     Pgp_DisplayMsg $v $tkw $part pgpresult
  1164. }
  1165.  
  1166. # store the signed text in a file
  1167. proc Pgp_GetSignedText {tkw part} {
  1168.     global mimeHdr
  1169.  
  1170.     set boundary $mimeHdr($part,param,boundary)
  1171.     regsub -all {([\.\+\?\(\)])} $boundary {\\&} boundarypat
  1172.     
  1173.     set fileIO [open $mimeHdr($part,file) r]
  1174.     set raw [read $fileIO]
  1175.     close $fileIO
  1176.  
  1177.     if {![regexp -- "--${boundarypat}\n(.*)\n--${boundarypat}.*--${boundarypat}--" $raw match text]} {
  1178.         error "<Pgp_GetSignedText>: Wrong PGP/MIME multipart/signed format"
  1179.     }
  1180.  
  1181.     set tmpFilename [Mime_TempFile $part=1]
  1182.     set tmpFile [open $tmpFilename w 0600]
  1183.  
  1184.     # set <CR><LF> eol translation
  1185.     fconfigure $tmpFile -translation crlf
  1186.  
  1187.     puts -nonewline $tmpFile $text
  1188.     close $tmpFile
  1189.  
  1190.     return $tmpFilename
  1191. }
  1192.  
  1193. # Show application/pgp
  1194. proc Pgp_ShowMessage { tkw part } {
  1195.     global mimeHdr mime miscRE exmh pgp
  1196.  
  1197.     set in [open $mimeHdr($part,file) r]
  1198.     gets $in firstLine
  1199.     close $in
  1200.  
  1201.     #########
  1202.     # Prolog
  1203.  
  1204.     # let's get the format
  1205.     if {![info exists mimeHdr($part,param,format)]} {
  1206.     lappend mimeHdr($part,params) format
  1207.     if [regexp $miscRE(beginpgpkeys) $firstLine] {
  1208.         set mimeHdr($part,param,format) keys-only
  1209.     } else {
  1210.         set mimeHdr($part,param,format) text
  1211.     }
  1212.     }
  1213.     set format $mimeHdr($part,param,format)
  1214.  
  1215.     Exmh_Debug "<Pgp_ShowMessage>: format $format part $part"
  1216.  
  1217.     # the action pgp performed
  1218.     if {"$format" != "keys-only"} {
  1219.     if {![info exists mimeHdr($part,param,x-action)]} {
  1220.         if [regexp $miscRE(beginpgpclear) $firstLine] {
  1221.         set action signclear
  1222.         set mimeHdr($part,param,x-action) signclear
  1223.             } else {
  1224.         set action encryptsign
  1225.         }
  1226.     } else {
  1227.         set action $mimeHdr($part,param,x-action)
  1228.     }
  1229.     } else {
  1230.     set action "keys-only"
  1231.     }
  1232.  
  1233.     # decide which version to use / implicitely checks for pgp enabled
  1234.     if { [catch {Pgp_CheckVersion $mimeHdr($part,file) real v} err] } {
  1235.         Exmh_Debug "<Pgp_ShowMessage> $err"
  1236.         Exmh_Status "Unknown PGP message version"
  1237.         Mime_ShowDefault $tkw $part
  1238.     return
  1239.     }
  1240.  
  1241.     # Labels to display: "real" is the Version of the program 
  1242.     # which prepared the pgp text, "local" the version, which
  1243.     # will be used to decode the thing
  1244.     set real [set pgp($real,fullName)]
  1245.     set local [set pgp($v,fullName)]
  1246.  
  1247.     # get the recipients if necessary
  1248.     if [regexp {encrypt} $action] {
  1249.     if {![info exists mimeHdr($part,param,x-recipients)]} {
  1250.         set recipients [string range [lindex [set pgp($v,myname)] 0] 2 end]
  1251.     } else {
  1252.         set recipients $mimeHdr($part,param,x-recipients)
  1253.     }
  1254.     set recipients [Pgp_Misc_Map elem {string trim $elem} [split $recipients ","]]
  1255.     }
  1256.  
  1257.     # see if we should decode the thing
  1258.     if {![info exists mimeHdr($part,pgpdecode)]} {
  1259.     set mimeHdr($part,pgpdecode) \
  1260.             [expr {[set pgp($v,enabled)] && [expr [set pgp(decode,[set pgp($v,showinline)])]]}]
  1261.     if [set pgp($v,enabled)] {
  1262.         MimeMenuAdd $part checkbutton \
  1263.             -label "[set pgp(menutext,$action)] with ${local}..." \
  1264.             -command [list busy MimeRedisplayPart $tkw $part] \
  1265.             -variable mimeHdr($part,pgpdecode)
  1266.     }
  1267.     }
  1268.  
  1269.     ##########
  1270.     # Decode
  1271.  
  1272.     # # # #
  1273.     # Mime
  1274.     if {($format == "mime") || ($format == "text")} {
  1275.     if $mimeHdr($part,pgpdecode) {
  1276.         set tmpfile [Mime_TempFile "decrypt"]
  1277.  
  1278.         if [regexp "encrypt" $action] {
  1279.         
  1280.         # Decide whether or not to use expect
  1281.                 set decrypt 1
  1282.                 if {[info exists pgp($v,useexpectk)]} {
  1283.             if {[set pgp(keeppass)] && [info exists exmh(expectk)] \
  1284.             && [set pgp($v,useexpectk)]} {
  1285.                 Exmh_Debug "<Pgp_ShowMessage> Using expect"
  1286.                 Pgp_Exec_DecryptExpect $v $mimeHdr($part,file) $tmpfile msg
  1287.                         set decrypt 0
  1288.                     }
  1289.                 }
  1290.         if $decrypt {
  1291.             Pgp_Exec_Decrypt $v $mimeHdr($part,file) $tmpfile msg $recipients
  1292.         }
  1293.         } else {
  1294.                 # NEW
  1295.                 Pgp_Exec_Verify $v $mimeHdr($part,file) msg $tmpfile
  1296.         }
  1297.  
  1298.             # tune output
  1299.         Pgp_InterpretOutput $v $msg pgpresult
  1300.             # display it
  1301.         Pgp_DisplayMsg $v $tkw $part pgpresult
  1302.  
  1303.         if {$pgpresult(ok)} {
  1304.         if [catch {set fileIO [open $tmpfile r]} err] {
  1305.             Exmh_Debug "<Pgp_ShowMessage> $err"
  1306.             return
  1307.         }
  1308.         File_Delete $tmpfile
  1309.     
  1310.         if {![info exists mimeHdr($part,numParts)]} {
  1311.             Exmh_Debug MimeParseSingle $part
  1312.             set mimeHdr($part,numParts) \
  1313.                            [MimeParseSingle $tkw $part $fileIO]
  1314.             set mimeHdr($part=1,color) \
  1315.                            [MimeDarkerColor $tkw $mimeHdr($part,color)]
  1316.         }
  1317.         MimeShowPart $tkw $part=1 [MimeLabel $part part] 1
  1318.         MimeClose $fileIO
  1319.         }
  1320.         
  1321.     } else {
  1322.         if {$action == "signclear"} {
  1323.         $tkw insert insert \
  1324.             "$real signed message - the signature hasn't been checked\n"
  1325.         TextButton $tkw "[set pgp(menutext,$action)] with $local" \
  1326.             "$mimeHdr($part,menu) invoke \
  1327.                     [join [set pgp(menutext,$action)] {\ }]\\ with\\ [join $local {\ }]...
  1328.                     \n$tkw config -cursor xterm"
  1329.         $tkw insert insert "\n"
  1330.         MimeInsertSeparator $tkw $part 6
  1331.         if [catch {Pgp_Misc_Unsign [Pgp_Misc_FileString $mimeHdr($part,file)]} msg] {
  1332.             $tkw insert insert "  can't find the signed message.\nPlease check it out: it might be suspicious !\n"
  1333.             return
  1334.         }
  1335.         if {$format == "mime"} {
  1336.             set tmpfile "$mimeHdr($part,file).msg"
  1337.             Pgp_Misc_StringFile $msg $tmpfile
  1338.             set fileIO [open $tmpfile r]
  1339.             File_Delete $tmpfile
  1340.             if {![info exists mimeHdr($part,numParts)]} {
  1341.             set mimeHdr($part,numParts) [MimeParseSingle $tkw $part $fileIO]
  1342.             set mimeHdr($part=1,color) [MimeDarkerColor $tkw $mimeHdr($part,color)]
  1343.             }
  1344.             MimeShowPart $tkw $part=1 [MimeLabel $part part] 1
  1345.             MimeClose $fileIO
  1346.         } else {
  1347.             $tkw insert insert $msg
  1348.         }
  1349.         } else {
  1350.                 if {$action == "encryptsign"} {
  1351.                     $tkw insert insert "This is a $real signed and encrypted message\n"
  1352.                 } elseif {$action == "encrypt"} {
  1353.                     $tkw insert insert "This is a $real encrypted message\n"
  1354.                 } elseif {$action == "signbinary"} {
  1355.                     $tkw insert insert "This is a $real binary signed message\n"
  1356.                 }
  1357.         TextButton $tkw "[set pgp(menutext,$action)] with $local" \
  1358.             "$mimeHdr($part,menu) invoke \
  1359.                     [join [set pgp(menutext,$action)] {\ }]\\ with\\ [join $local {\ }]...
  1360.                     \n$tkw config -cursor xterm"
  1361.         $tkw insert insert "\n"
  1362.         Mime_ShowDefault $tkw $part
  1363.         }
  1364.     }
  1365.     # # # # # # #
  1366.     # keys-only
  1367.     } elseif {$format == "keys-only"} {
  1368.     if [set pgp($v,autoextract)] {
  1369.         Pgp_Exec_ExtractKeys $v $mimeHdr($part,file) out 0
  1370.     } else {
  1371.         MimeMenuAdd $part command \
  1372.             -label "Extract $real keys into $local keyring..." \
  1373.             -command "Pgp_Exec_ExtractKeys $v $mimeHdr($part,file) out"
  1374.         TextButton $tkw "Extract $real keys into $local keyring" \
  1375.                 "Pgp_Exec_ExtractKeys $v $mimeHdr($part,file) out"
  1376.         $tkw insert insert "\n"
  1377.     }
  1378.     if $mimeHdr($part,pgpdecode) {
  1379.         Pgp_Exec_Verify $v $mimeHdr($part,file) msg
  1380.             # NEW
  1381.         regexp [set pgp($v,pat_validKeys)] $msg msg
  1382.         $tkw insert insert "$msg\n"
  1383.     } else {
  1384.         Mime_ShowDefault $tkw $part
  1385.     }
  1386.     # # # # # #
  1387.     # unknown
  1388.     } else {
  1389.     $tkw insert insert "PGP application format '$format' unknown\n"
  1390.     return
  1391.     }
  1392. }
  1393.  
  1394. # Attach keys
  1395. proc Pgp_InsertKeys { draft t } {
  1396.     global env pgp
  1397.  
  1398.     # Figure out PGP version from per-draft variable
  1399.     # multipgp originally had this passed in explicitly but this way
  1400.     # is a little cleaner (we think)
  1401.     set v $pgp(version,[SeditId $draft])
  1402.  
  1403.     if [catch {Pgp_KeyBox $v "Select the keys to be attached" Pub \
  1404.         [Pgp_Match_FlatKeyList $v "" Pub]} keys] {
  1405.     SeditMsg $t $keys
  1406.     return
  1407.     }
  1408.     # insert keys
  1409.     foreach key $keys {
  1410.     set keyid [lindex $key 0]
  1411.     if {![info exists done($keyid)]} {
  1412.         set done($keyid) 1
  1413.         set tmpfile [Mime_TempFile "insertkeys"]
  1414.             if [catch {Pgp_Exec_GetKeys $v $keyid $tmpfile} msg] {
  1415.                 SeditMsg $t "[set pgp($v,fullName)] refuses to generate the key message"
  1416.         Exmh_Debug "<Pgp_InsertKeys> $msg"
  1417.         return
  1418.             }
  1419.         # insert key file
  1420.         SeditInsertFile $draft $t $tmpfile 1 7bit {application/pgp-keys} "keys of [lindex $key 4]"
  1421.         File_Delete $tmpfile
  1422.     }
  1423.     }
  1424. }
  1425.  
  1426. proc Pgp_GetTextAttributes { summary } {
  1427.     global pgp
  1428.  
  1429.     switch $summary {
  1430.     GoodSignatureUntrusted {return $pgp(msgcolor,GoodUntrustedSig)}
  1431.     GoodSignatureTrusted   {return $pgp(msgcolor,GoodTrustedSig)}
  1432.     BadSignatureTrusted    {return $pgp(msgcolor,Bad)}
  1433.     BadSignatureUntrusted  {return $pgp(msgcolor,Bad)}
  1434.         SecretMissing          {return $pgp(msgcolor,Bad)}
  1435.         PublicMissing          {return $pgp(msgcolor,Bad)}
  1436.         default                {return $pgp(msgcolor,OtherMsg)}
  1437.     }
  1438. }
  1439.  
  1440. proc Pgp_DisplayMsg { v tkw part pgpresultvar } {
  1441.     upvar $pgpresultvar pgpresult
  1442.     global pgp
  1443.  
  1444.     Exmh_Debug "<Pgp_DisplayMsg> $pgpresult(msg)"
  1445.  
  1446.     if {[info exists pgpresult(keyid)]} {
  1447.     MimeMenuAdd $part command \
  1448.         -label "Query keyserver for key $pgpresult(keyid)" \
  1449.         -command "Pgp_WWW_QueryKey $v $pgpresult(keyid)"
  1450.     if {[regexp "PublicMissing" $pgpresult(summary)]} {
  1451.         TextButton $tkw "Query keyserver" \
  1452.         "Pgp_WWW_QueryKey $v $pgpresult(keyid)"
  1453.     }
  1454.     $tkw insert insert "\n"
  1455.     }
  1456.  
  1457.     set rval [Pgp_GetTextAttributes $pgpresult(summary)]
  1458.     if {$rval != {}} {
  1459.     if [catch {eval {$tkw tag configure PgpResults} $rval} err] {
  1460.         Exmh_Debug tag configure PgpResults $rval: $err
  1461.         $tkw insert insert "$pgpresult(msg)\n"
  1462.     } else {
  1463.         $tkw insert insert "$pgpresult(msg)\n" PgpResults
  1464.     }
  1465.     } else {
  1466.     $tkw insert insert "$pgpresult(msg)\n"
  1467.     }
  1468.     Exmh_Debug "pgpresult(ok): $pgpresult(ok)"
  1469.     if {$pgpresult(ok) == 0} {
  1470.     MimeInsertSeparator $tkw $part 6
  1471.     MimeWithDisplayHiding $tkw $part {
  1472.         Mime_WithTextFile fileIO $tkw $part {
  1473.         set start [$tkw index insert]
  1474.         $tkw insert insert [read $fileIO]
  1475.         set end [$tkw index insert]
  1476.         Msg_TextHighlight $tkw $start $end
  1477.         }
  1478.     }
  1479.     }
  1480.     MimeInsertSeparator $tkw $part 6
  1481. }
  1482.  
  1483. proc Pgp_InterpretOutput { v in outvar } {
  1484.     global pgp
  1485.  
  1486.     # This function is supposed to take the output given by the other
  1487.     # pgp exec procedures and writes different information to the
  1488.     # given array.  It is probably best to put all the code that
  1489.     # change from PGP version to version in a single place.
  1490.  
  1491.     upvar $outvar pgpresult
  1492.  
  1493.     Exmh_Debug "<Pgp_InterpretOutput> PGP Output:\n$in"
  1494.     regexp {(.*)child process exited abnormally} $in {} in
  1495.     set in [string trim $in]
  1496.     if {[string length $in] == 0} {
  1497.     set in "PGP execution produced no messages."
  1498.     }
  1499.  
  1500.     set pgpresult(ok) 1
  1501.  
  1502.     # get out the keyid
  1503.     eval [set pgp($v,cmd_Keyid)]
  1504.  
  1505.     if [info exists pgpresult(keyid)] {
  1506.     catch {Exmh_Debug "<Pgp_InterpretOutput> $pgpresult(keyid)"}
  1507.     }
  1508.  
  1509.     # interpret the output
  1510.     if [regexp [set pgp($v,pat_SecretMissing)] $in redin] {
  1511.     set pgpresult(summary) "SecretMissing"
  1512.     set pgpresult(ok) 0
  1513.     } elseif [regexp [set pgp($v,pat_PublicMissing)] $in redin] {
  1514.     set pgpresult(summary) "PublicMissing"
  1515.     set pgpresult(ok) 1
  1516.     } elseif [regexp [set pgp($v,pat_GoodSignature)] $in redin] {
  1517.     if [regexp [set pgp($v,pat_Untrusted)] $in] {
  1518.         set pgpresult(summary) "GoodSignatureUntrusted"
  1519.     } else {set pgpresult(summary) "GoodSignatureTrusted"}
  1520.     } elseif [regexp [set pgp($v,pat_BadSignature)] $in redin] {
  1521.     if [regexp [set pgp($v,pat_Untrusted)] $in] {
  1522.         set pgpresult(summary) "BadSignatureUntrusted"
  1523.     } else {set pgpresult(summary) "BadSignatureTrusted"}
  1524.     } elseif [regexp [set pgp($v,pat_UnknownError)] $in redin] {
  1525.     set pgpresult(summary) "UnknownError"
  1526.     set pgpresult(ok) 0
  1527.     } else {
  1528.     set pgpresult(summary) "Other"
  1529.         set redin $in
  1530.     }
  1531.  
  1532.     # get out user (for ShortenOutput) now since beautify erases needed info
  1533.     eval [set pgp($v,cmd_User)]
  1534.     if {![info exists user]} {
  1535.     set user UNKNOWN
  1536.     }
  1537.  
  1538.     Exmh_Debug <TUNING>
  1539.     # An output tuning command
  1540.     # NOTE: pgpresult(msg) should also be set there
  1541.     # set pgpresult(msg) to
  1542.     #   in    (this is the complete original output from pgp)
  1543.     #   redin (this is the output matched out)
  1544.     if [info exists pgp($v,cmd_Beauty)] {
  1545.         eval [set pgp($v,cmd_Beauty)]
  1546.     }
  1547.  
  1548.     Exmh_Debug "<Pgp_InterpretOutput> beautiful output: $pgpresult(msg)"
  1549.  
  1550.     # DecryptExpect sometimes notifies the user that the
  1551.     # file is not encrypted.
  1552.     
  1553.     if [regexp {Note: File may not have been encrypted} $in] {
  1554.     set pgpresult(msg) \
  1555.         "Note: File may not have been encrypted.\n\n$pgpresult(msg)"
  1556.     }
  1557.  
  1558.     Exmh_Debug OK=$pgpresult(ok) $pgpresult(summary)
  1559.  
  1560.     if [set pgp($v,shortmsgs)] {
  1561.     set pgpresult(msg) [Pgp_ShortenOutput $v $pgpresult(msg) \
  1562.                 $pgpresult(summary) $user]
  1563.     }
  1564. }
  1565.  
  1566. proc Pgp_ShortenOutput { v pgpresult summary user } {
  1567.     global pgp
  1568.  
  1569.     catch {Exmh_Debug "<PGP ShortenOutput> $user"}
  1570.  
  1571.     switch $summary {
  1572.        SecretMissing {return "Cannot decrypt, missing secret key."}
  1573.        PublicMissing {return "Missing public key."}
  1574.        GoodSignatureUntrusted {return "Good untrusted signature from $user."}
  1575.        GoodSignatureTrusted {return "Good trusted signature from $user."}
  1576.        BadSignature {return "Bad signature from $user."}
  1577.        BadSignatureTrusted {return "WARNING: Bad trusted signature \
  1578.         from $user."}
  1579.        BadSignatureUntrusted {return "WARNING: Bad untrusted signature \
  1580.         from $user."}
  1581.        UnknownError {return "PGP Error while processing message:\n$pgpresult"}
  1582.        Other {return $pgpresult}
  1583.     }
  1584. }
  1585.  
  1586.